home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
MENU_UTL
/
DESIGN
/
ERR.INC
< prev
next >
Wrap
Text File
|
1988-12-26
|
3KB
|
99 lines
function ToHex(J : word) : String10;
const
HexCheck : array[0..15] of char = '0123456789ABCDEF';
var
I : word;
begin {ToHex}
ToHex[0] := Chr(4);
for I := 0 to 3 do
begin
ToHex[4 - I] := HexCheck[J and $000F];
J := J shr 4
end
end; {ToHex}
{$F+} Procedure CustomExit; {$F-}
Var
i : Integer;
Msg : String80;
Begin
if ErrorAddr <> NIL then
Begin
Make_Window(10,8,70,18,White,Red);
if ExitCode = 160 then
begin
Writeln;
Write(#7,' Printer off line. Press ENTER: ');
Readln;
ErrorAddr := NIL; { Cancel runtime error }
ExitCode := 0;
For i := 1 to 5 do
Remove_Window;
Main(1)
end else
begin
Close(d); { Close file in case of fatal error. }
Writeln(#7,' A problem has developed.');
Writeln(' Address = ',ToHex(Seg(ErrorAddr^)),
':',ToHex(Ofs(ErrorAddr^)));
Case ExitCode of
2 : Msg := 'File not found';
3 : Msg := 'Path not found';
4 : Msg := 'Too many open files';
5 : Msg := 'File access denied';
6 : Msg := 'Invalid file handle or damaged file';
12 : Msg := 'Invalid drive number';
15 : Msg := 'Invalid drive';
17 : Msg := 'Cannot rename across drives';
100 : Msg := 'Disk read error';
101 : Msg := 'Disk write error';
102 : Msg := 'File not assigned';
103 : Msg := 'File not open';
105 : Msg := 'File not open for output';
106 : Msg := 'Invalid numeric format';
150 : Msg := 'Disk is write protected';
152 : Msg := 'Drive not ready';
153 : Msg := 'Unknown command';
154 : Msg := 'CRC error in data';
155 : Msg := 'Bad drive request structure length';
156 : Msg := 'Disk seek error';
157 : Msg := 'Unknown media type';
158 : Msg := 'Sector not found';
159 : Msg := 'Printer out of paper';
160 : Msg := 'Device write fault';
161 : Msg := 'Device read fault';
162 : Msg := 'Hardware failure';
200 : Msg := 'Division by zero';
202 : Msg := 'Stack overflow error';
203 : Msg := 'Heap overflow error';
205 : Msg := 'Floating point overflow';
206 : Msg := 'Floating pint underflow';
207 : Msg := 'Invalid floating point operation';
else
Msg := 'Undefined error';
End; { Case }
Writeln(' ', Msg+'.');
Writeln(' Code = ',ExitCode);
Writeln;
Write(' Press ENTER: ');
Readln;
ErrorAddr := NIL; { Cancel runtime error }
ExitCode := 0;
for i := 1 to 5 do
Remove_Window;
Open_File; { Reopen file }
Main(1);
end;
ErrorAddr := NIL; { Cancel runtime error }
ExitCode := 0;
End; { If }
ExitProc := SavedExitProc; { Restore saved ExitProc pointer }
End; { CustomExit }